home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 9 Archive / 09-Archive.zip / lxlt121s.zip / lxLite_src / sysIcons.pas < prev    next >
Pascal/Delphi Source File  |  1997-05-09  |  17KB  |  510 lines
  1. {****************************************************************************}
  2. {                                                                            }
  3. {                       System Icons & Pointers editor                       }
  4. {               Written by Andrew Zabolotny of FRIENDS software              }
  5. {    No copyrights, no legal stuff, no credits, no greetings, no nothing.    }
  6. {                                                                            }
  7. {****************************************************************************}
  8. { Comments:This was my first program for OS/2 and I cannot guarantee nothing }
  9. {          about it except it will try to do something... hope succesfully.  }
  10. {          I seen a similar proggy... and I hasn`t been satisfied because    }
  11. {          a) It always used reference to file                               }
  12. {          b) It does not allow to edit pointer (using IconEdit, of course)  }
  13. {          c) It was not mine :-)                                            }
  14. {          ... and I wrote this one. Hope you like it.                       }
  15. {****************************************************************************}
  16. {$frame-,speed-,smartlink+}
  17. {$R sysIcons.res}
  18. uses Dos, Strings, os2def, os2base, os2pmapi, miscUtil, strOp, use32;
  19.  
  20. const
  21. {* Dialog control IDs converted from sysicons.h *}
  22.     idMAINWINDOW             = 100;
  23.     idICONLIST               = 101;
  24.     idICONNAME               = 102;
  25.     idBUTCHANGE              = 103;
  26.     idBUTUNDO                = 104;
  27.     idBUTDEFAULT             = 105;
  28.     idBUTQUIT                = 106;
  29.     idSTOREDIRECT            = 107;
  30.     idSTOREINDIRECT          = 108;
  31.     idBUTEDIT                = 109;
  32.     idICONBORDER             = 110;
  33.     idBUTLOADSET             = 111;
  34.     idENDEDIT                = 1000;
  35.  
  36. const
  37.     nStdNames    = 19;
  38.     cStdNames    : array[1..nStdNames] of pChar =
  39.     ('Mouse arrow pointer',
  40.      'Text cursor pointer',
  41.      'Wait pointer',
  42.      'Sizing window pointer',
  43.      'Moving window pointer',
  44.      'Resizing \ pointer',
  45.      'Resizing / pointer',
  46.      'Resizing - pointer',
  47.      'Resizing | pointer',
  48.      'Application icon',
  49.      'Information icon',
  50.      'Question icon',
  51.      'Error icon',
  52.      'Warning icon',
  53.      'Illegal action icon',
  54.      'Default file icon',
  55.      'Default folder icon',
  56.      'Multiple file icon',
  57.      'Default program icon');
  58.     cStdNums     : array[1..nStdNames] of Byte =
  59.     (sptr_Arrow,
  60.      sptr_Text,
  61.      sptr_Wait,
  62.      sptr_Size,
  63.      sptr_Move,
  64.      sptr_Sizenwse,
  65.      sptr_Sizenesw,
  66.      sptr_Sizewe,
  67.      sptr_Sizens,
  68.      sptr_AppIcon,
  69.      sptr_IconInformation,
  70.      sptr_IconQuestion,
  71.      sptr_IconError,
  72.      sptr_IconWarning,
  73.      sptr_Illegal,
  74.      sptr_File,
  75.      sptr_Folder,
  76.      sptr_Multfile,
  77.      sptr_Program);
  78.     fnTempFile   = 'si!tmp.ptr';
  79.     pmSysPtrID   : pChar = 'PM_SysPointer';
  80.     msgStored    : pChar = 'Stored in INI';
  81.     msgUnknSM    : pChar = 'Unknown storage method';
  82.     msgDefault   : pChar = 'Using default pointer';
  83.     msgUnknown   : pChar = 'Unused pointer ID: 000';
  84.     setKeyword   : pChar = 'arrowtextwaitsizemovesizenwsesizenesw'+
  85.                            'sizewesizensapplicationinformationquestion'+
  86.                            'errorwarningillegaldeffiledeffoldermultfile'+
  87.                            'defprogram';
  88. type
  89.     pINIpointer  = ^tINIpointer;
  90.     tINIpointer  = record
  91.                     iconType : Longint;
  92.                     iconData : Longint;
  93.                     restData : array[0..0] of Byte;
  94.                    end;
  95.  
  96. var appHAB       : HAB;
  97.     appHMQ       : HMQ;
  98.     newPointer   : boolean;
  99.     oldPointer   : pINIpointer;
  100.     oldPointerS  : ULong;
  101.     oldPointerI  : IconInfo;
  102.     editThreadID : uLong;
  103.     tempIconName : String;
  104.     tempFile     : boolean;
  105.     editError    : boolean;
  106.  
  107. {* Use for editing a different thread... `cause we cannot *}
  108. {* block main message queue even when editing pointer     *}
  109. Function editThread(Arg : uLong) : uLong; cDecl;
  110. label
  111.     locEx;
  112. var pS  : String;
  113.     F   : File;
  114.     MQ  : HMQ;
  115. begin
  116.  editError := TRUE;
  117.  MQ := WinCreateMsgQueue(appHAB, 0);
  118.  pS := fSearch('iconedit.exe', '.;'+GetEnv('PATH'));
  119.  if pS = ''
  120.   then begin
  121.         WinMessageBox(hWnd_Desktop, hWnd_Desktop,
  122.                       'Cannot find ICONEDIT.EXE'#13'in one of PATH directories',
  123.                       'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  124.         Goto locEx;
  125.        end;
  126.  if oldPointerS = 0
  127.   then begin
  128.         WinMessageBox(hWnd_Desktop, hWnd_Desktop,
  129.                       'Cannot edit default system pointer'#13+
  130.                       'Please load first another pointer'#13+
  131.                       'instead of default',
  132.                       'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  133.         Goto locEx;
  134.        end;
  135.  
  136.  if oldPointer^.iconType = 1
  137.   then begin
  138.         tempFile := FALSE;
  139.         tempIconName := StrPas(@oldPointer^.iconData);
  140.        end
  141.   else begin
  142.         tempFile := TRUE;
  143.         tempIconName := fExpand(fnTempFile); Assign(F, tempIconName);
  144.         if oldPointerI.cbIconData = 0
  145.          then Erase(F)
  146.          else begin
  147.                Rewrite(F, 1);
  148.                if ioResult <> 0
  149.                 then begin
  150.                       WinMessageBox(hWnd_Desktop, hWnd_Desktop,
  151.                                     'Cannot write temporary file',
  152.                                     'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  153.                       Exit;
  154.                      end;
  155.                BlockWrite(F, oldPointerI.pIconData^, oldPointerI.cbIconData);
  156.                Close(F);
  157.               end;
  158.         inOutRes := 0;{* Clear ioResult in the case if Erase or Close failed*}
  159.        end;
  160.  Exec(pS, tempIconName);
  161.  editError := FALSE;
  162. locEx:
  163.  WinPostQueueMsg(appHMQ, WM_COMMAND, idENDEDIT, 0);
  164.  WinDestroyMsgQueue(MQ);
  165.  DosExit(EXIT_THREAD, 0);
  166. end;
  167.  
  168. Function DlgWindowProc(Window : hWnd; Msg : ULong; mp1,mp2 : MParam) : MResult; cDecl;
  169.  
  170. {* Ask user to choose a file using standard file dialog box *}
  171. Function ChooseFile(fMask,fTitle : pChar) : String;
  172. var fD : FileDlg;
  173.     rC : UShort;
  174.     _D : DirStr;
  175.     _N : NameStr;
  176.     _E : ExtStr;
  177. begin
  178.  FillChar(fD, sizeOf(fD), 0);
  179.  fD.cbSize := sizeOf(fD);
  180.  fD.fl := FDS_CENTER or FDS_OPEN_DIALOG;
  181.  fD.pszTitle := fTitle;
  182.  strCopy(fD.szFullFile, fMask);
  183.  rC := WinFileDlg(hWnd_Desktop, Window, fD);
  184.  
  185.  if (rC <> 0) and (fD.lReturn = DID_OK)
  186.   then begin
  187.         fSplit(strPas(fD.szFullFile), _D, _N, _E);
  188.         if (_D <> '') and (_D[length(_D)] = '\') then Dec(byte(_D[0]));
  189.         ChDir(_D); ChooseFile := strPas(fD.szFullFile);
  190.        end
  191.   else ChooseFile := '';
  192. end;
  193.  
  194. {* Return selected pointer ID *}
  195. Function GetCurrentPointer : ULong;
  196. begin
  197.  GetCurrentPointer := cStdNums[succ(UShort(WinSendDlgItemMsg(Window, idICONLIST, LM_QUERYSELECTION, 0, 0)))];
  198. end;
  199.  
  200. {* Return storage method - 0 = store as ICON_FILE; 1 = store as ICON_DATA *}
  201. Function GetStorageMethod : byte;
  202. begin
  203.  GetStorageMethod := byte(WinSendDlgItemMsg(Window, idSTOREDIRECT, BM_QUERYCHECK, 0, 0));
  204. end;
  205.  
  206. {* Display pointer in idICONBORDER window *}
  207. Procedure ShowPointer;
  208. var ps        : HPS;
  209.     icon      : hPointer;
  210.     Selection : ULong;
  211.     iconName  : pChar;
  212.     Rect      : Rectl;
  213.     iconP     : pINIpointer;
  214.     iconS     : uLong;
  215.     tS        : String;
  216. begin
  217.  Selection := GetCurrentPointer;
  218.  Icon := WinQuerySysPointer(hWnd_Desktop, Selection, FALSE);
  219.  tS := long2str(Selection) + #0;
  220.  if (Icon <> 0)
  221.   then begin
  222.         if (PrfQueryProfileSize(HINI_USERPROFILE, pmSysPtrID, @tS[1], iconS))
  223.          then begin
  224.                GetMem(iconP, iconS);
  225.                if PrfQueryProfileData(HINI_USERPROFILE, pmSysPtrID, @tS[1], iconP, iconS)
  226.                 then case iconP^.iconType of
  227.                       1 : iconName := @iconP^.IconData;
  228.                       3 : iconName := msgStored;
  229.                      else iconName := msgUnknSM;
  230.                      end
  231.                 else begin
  232.                       FreeMem(iconP, iconS);
  233.                       iconS := 0;
  234.                      end;
  235.               end
  236.          else iconName := msgDefault;
  237.        end
  238.   else begin
  239.         iconName := msgUnknown; iconS := 0;
  240.         tS := Strg('0', 4 - length(tS)) + tS;
  241.         Move(tS[1], pByteArray(iconName)^[strLen(msgUnknown) - 3], 3);
  242.        end;
  243.  
  244. {* Display icon *}
  245.  ps := WinGetPS(WinWindowFromID(Window, idICONBORDER));
  246.  Rect.xLeft := 2; Rect.xRight := 4+32;
  247.  Rect.yBottom := 2; Rect.yTop := 4+32;
  248.  WinFillRect(ps, Rect, sysclr_DialogBackground);
  249.  if Icon <> 0 then WinDrawPointer(ps, 4, 4, Icon, DP_NORMAL);
  250.  WinSetDlgItemText(Window, idICONNAME, iconName);
  251.  WinReleasePS(ps);
  252.  
  253. {* Store icon in UNDO buffer *}
  254.  if newPointer
  255.     then begin
  256.           FreeMem(oldPointerI.pIconData, oldPointerI.cbIconData);
  257.           oldPointerI.cbIconData := 0;
  258.           WinQuerySysPointerData(hWnd_Desktop, Selection, oldPointerI);
  259.           GetMem(oldPointerI.pIconData, oldPointerI.cbIconData);
  260.           WinQuerySysPointerData(hWnd_Desktop, Selection, oldPointerI);
  261.           FreeMem(oldPointer, oldPointerS);
  262.           oldPointer := iconP; oldPointerS := iconS;
  263.           newPointer := FALSE;
  264.          end
  265.     else FreeMem(iconP, iconS);
  266. end;
  267.  
  268. {* Reload pointer if changed *}
  269. Procedure ResetPointer;
  270. begin
  271.  WinShowPointer(hWnd_Desktop, FALSE);
  272.  WinShowPointer(hWnd_Desktop, TRUE);
  273.  ShowPointer;
  274. end;
  275.  
  276. {* Reset pointer to default *}
  277. Procedure SetDefaultPointer;
  278. begin
  279.  WinSetSysPointerData(hWnd_Desktop, GetCurrentPointer, pIconInfo(nil));
  280.  ResetPointer;
  281. end;
  282.  
  283. {* Undo pointer image *}
  284. Procedure DoUndo;
  285. var Selection : USHORT;
  286.     tempS     : String[4];
  287. begin
  288.  if oldPointerS = 0 then begin SetDefaultPointer; Exit; end;
  289.  Selection := GetCurrentPointer;
  290.  WinSetSysPointerData(hWnd_Desktop, Selection, @oldPointerI);
  291.  Str(Selection, tempS); tempS := tempS + #0;
  292.  PrfWriteProfileData(HINI_USERPROFILE, pmSysPtrID, @tempS[1], oldPointer, oldPointerS);
  293.  ResetPointer;
  294. end;
  295.  
  296. {* Load current icon from file *}
  297. Function LoadCurrentIcon(const fName : String) : boolean;
  298. label
  299.     locEx;
  300. var F     : File;
  301.     Buff  : Pointer;
  302.     iconS : ULong;
  303.     tempS : String;
  304.     ii    : IconInfo;
  305. begin
  306.  LoadCurrentIcon := FALSE;
  307.  inOutRes := 0;
  308.  Assign(F, fName); Reset(F, 1);
  309.  if ioResult <> 0
  310.   then begin
  311.         tempS := Copy('Cannot open file'#13 + fName, 1, 254) + #0;
  312.         WinMessageBox(hWnd_Desktop, Window,
  313.                       @tempS[1], 'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  314.         Exit;
  315.        end;
  316. {Always set ICON_DATA so changes will take effect immediately}
  317. {even if <store file reference> is in effect}
  318.  ii.cb := sizeOf(ii);
  319.  ii.fFormat := ICON_DATA;
  320.  iconS := fileSize(F); GetMem(Buff, iconS);
  321.  BlockRead(F, Buff^, iconS);
  322.  ii.cbIconData := iconS;
  323.  ii.pIconData := Buff;
  324.  WinSetSysPointerData(hWnd_Desktop, GetCurrentPointer, @ii);
  325.  if GetStorageMethod = 0
  326.   then begin
  327.         FreeMem(Buff, iconS);
  328.         ii.fFormat := ICON_FILE;
  329.         iconS := length(fName) + 1; GetMem(Buff, iconS);
  330.         StrPCopy(Buff, fName);
  331.         ii.pszFileName := Buff;
  332.        end;
  333.  WinSetSysPointerData(hWnd_Desktop, GetCurrentPointer, @ii);
  334.  FreeMem(Buff, iconS);
  335.  LoadCurrentIcon := TRUE;
  336.  ResetPointer;
  337. locEx:
  338.  Close(F);
  339.  inOutRes := 0;
  340. end;
  341.  
  342. {* <Change> button *}
  343. Procedure DoChange;
  344. var tS : String;
  345. begin
  346.  tS := ChooseFile('*.PTR', 'Choose pointer file');
  347.  if tS = '' then Exit;
  348.  LoadCurrentIcon(tS);
  349.  ShowPointer;
  350. end;
  351.  
  352. {* <Edit> button *}
  353. Procedure DoEdit;
  354. begin
  355.  DosCreateThread(editThreadID, editThread, 0, 0, 8192);
  356.  WinEnableWindow(WinWindowFromID(Window, idICONLIST), FALSE);
  357. end;
  358.  
  359. {* <Load Set> button *}
  360. Procedure DoLoadSet;
  361. var tS        : String;
  362.     T         : Text;
  363.     KW        : SmallWord;
  364.     Selection : ULong;
  365. begin
  366.  tS := ChooseFile('*.SET', 'Choose list file');
  367.  if tS = '' then Exit;
  368.  inOutRes := 0;
  369.  Assign(T, tS); Reset(T);
  370.  if ioResult <> 0
  371.   then begin
  372.         tS := Copy('Error reading set'#13 + tS, 1, 254) + #0;
  373.         WinMessageBox(hWnd_Desktop, Window,
  374.                       @tS[1], 'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  375.         Exit;
  376.        end;
  377.  Selection := GetCurrentPointer;
  378.  While (ioResult = 0) and (not seekEOF(T)) do
  379.   begin
  380.    Readln(T, tS);
  381.    KW := First(';', tS);
  382.    if KW > 0 then tS := copy(tS, 1, pred(KW));
  383.    DelStartSpaces(tS);
  384.    if tS = '' then Continue;
  385.    KW := KeywordSpc(tS, setKeyword^);
  386.    if KW = 0
  387.     then begin
  388.           tS := Copy('Unknown keyword in line'#13 + tS, 1, 254) + #0;
  389.           WinMessageBox(hWnd_Desktop, Window,
  390.                         @tS[1], 'Error', 0, MB_ICONEXCLAMATION+MB_MOVEABLE+MB_ENTER);
  391.           break;
  392.          end;
  393.    DelStartSpaces(tS); Dec(KW);
  394.    WinSendDlgItemMsg(Window, idICONLIST, LM_SELECTITEM,
  395.                      MPARAM(KW), MPARAM(TRUE));
  396.    if tS = ''
  397.     then SetDefaultPointer
  398.     else LoadCurrentIcon(fExpand(tS));
  399.   end;
  400.  Close(T); inOutRes := 0;
  401.  For KW := 1 to nStdNames do
  402.   if Selection = cStdNums[KW]
  403.    then begin
  404.          WinSendDlgItemMsg(Window, idICONLIST, LM_SELECTITEM,
  405.                            MPARAM(Pred(KW)), MPARAM(TRUE));
  406.          break;
  407.         end;
  408. end;
  409.  
  410. Procedure DoFinishEdit;
  411. begin
  412.  if not editError
  413.   then begin
  414.         newPointer := TRUE;
  415.         if tempFile
  416.          then WinCheckButton(Window, idSTOREDIRECT, 1);
  417.         LoadCurrentIcon(tempIconName);
  418.         if tempFile
  419.          then begin
  420.                tempIconName := tempIconName + #0;
  421.                DosDelete(@tempIconName[1]);
  422.               end;
  423.        end;
  424.  WinEnableWindow(WinWindowFromID(Window, idICONLIST), TRUE);
  425. end;
  426.  
  427.  
  428. var deskRect,
  429.     applRect  : Rectl;
  430.     i         : Integer;
  431. begin
  432.  DlgWindowProc := 0;
  433.  case Msg of
  434.   WM_INITDLG : begin
  435.                 WinQueryWindowRect(hWnd_Desktop, deskRect);
  436.                 WinQueryWindowRect(Window, applRect);
  437.                 ApplRect.xLeft := deskRect.xLeft +
  438.                                   ((deskRect.xRight - deskRect.xLeft) -
  439.                                    (applRect.xRight - applRect.xLeft)) div 2;
  440.                 ApplRect.yBottom := deskRect.yBottom +
  441.                                   ((deskRect.yTop - deskRect.yBottom) -
  442.                                    (applRect.yTop - applRect.yBottom)) div 2;
  443.                 WinSetWindowPos (Window, hWnd_TOP,
  444.                                  applRect.xLeft, applRect.yBottom,
  445.                                  0, 0, SWP_MOVE or SWP_SHOW);
  446.                 For i := 1 to nStdNames do
  447.                     WinSendDlgItemMsg(Window, idICONLIST, LM_INSERTITEM,
  448.                         MPFROM2SHORT(SmallWord(LIT_END), 0), MPARAM(cStdNames[i]));
  449.                 WinSendDlgItemMsg(Window, idICONLIST, LM_SELECTITEM,
  450.                                   MPARAM(0), MPARAM(TRUE));
  451.                 WinCheckButton(Window, idSTOREDIRECT, 1);
  452.                end;
  453.   WM_CONTROL : case SmallWord(mp1) of
  454.                 idICONLIST   : case mp1 shr 16 of
  455.                                 LN_SELECT : begin newPointer := TRUE; ShowPointer; end;
  456.                                end;
  457.                end;
  458.   WM_COMMAND : case SmallWord(mp1) of
  459.                 idBUTDEFAULT : SetDefaultPointer;
  460.                 idBUTCHANGE  : DoChange;
  461.                 idBUTUNDO    : DoUndo;
  462.                 idBUTEDIT    : DoEdit;
  463.                 idBUTLOADSET : DoLoadSet;
  464.                 idBUTQUIT    : WinDismissDlg(Window, DID_OK);
  465.                 idENDEDIT    : DoFinishEdit;
  466.                end;
  467.   else DlgWindowProc := WinDefDlgProc(Window, Msg, mp1, mp2);
  468.  end;
  469. end;
  470.  
  471. {* Dummy window procedure *}
  472. Function mainWinProc(Window : hWnd; Msg : ULong; mp1,mp2 : MParam) : MResult; cdecl;
  473. begin
  474.  mainWinProc := 0;
  475.  case Msg of
  476.   WM_CREATE : begin
  477.                WinDlgBox(hWnd_Desktop, hWnd_Desktop, DlgWindowProc, 0,
  478.                          idMAINWINDOW, NIL);
  479.                WinPostQueueMsg(appHMQ, WM_QUIT, 0, 0);
  480.               end;
  481.   else mainWinProc := WinDefWindowProc(Window, Msg, mp1, mp2);
  482.  end;
  483. end;
  484.  
  485. var frame,Client : hwnd;
  486.     Msg          : qMsg;
  487.     FrameFlags   : uLong;
  488.  
  489. begin
  490. {* Init UNDO structure *}
  491.  oldPointerI.cb := sizeOf(oldPointerI);
  492. {* WinGetSysPointerData always return ICON_DATA *}
  493.  oldPointerI.fFormat := ICON_DATA;
  494.  appHAB := WinInitialize(0);
  495.  appHMQ := WinCreateMsgQueue(appHAB, 0);
  496.  if appHMQ = 0 then Halt(254);
  497. {* Register a dummy class so program will appear in tasklist *}
  498.  WinRegisterClass(appHAB, 'SysIcons', MainWinProc, cs_SizeRedraw, 0);
  499.  Frame := WinCreateStdWindow(hWnd_Desktop, ws_Disabled, FrameFlags,
  500.                              'SysIcons', nil, 0, 0, 0, @Client);
  501. {* Do it *}
  502.  if Frame <> 0
  503.   then While (WinGetMsg(appHAB,Msg,0,0,0)) do WinDispatchMsg(appHAB,Msg);
  504.  
  505. {* Destroy anything that can be destroyed (AKA kill`em`all) *}
  506.  WinDestroyWindow(Frame);
  507.  WinDestroyMsgQueue(appHMQ);
  508.  WinTerminate(appHAB);
  509. end.
  510.