From 06d4cc253c81f49fad6323207cafdb0925fcfbe6 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 26 Feb 2025 20:34:49 +0100 Subject: [PATCH] Issue #1482: add about box and generic_types unit --- heidisql.lpi | 23 ++- heidisql.lpr | 4 +- source/about.lfm | 367 +++++++++++++++++++++++++++++++++++++++ source/about.pas | 173 ++++++++++++++++++ source/apphelpers.pas | 270 +++++++++++++--------------- source/generic_types.pas | 13 ++ source/main.lfm | 9 +- source/main.pas | 57 +++--- 8 files changed, 727 insertions(+), 189 deletions(-) create mode 100644 source/about.lfm create mode 100644 source/about.pas create mode 100644 source/generic_types.pas diff --git a/heidisql.lpi b/heidisql.lpi index e7ef9f3e..6cd372f3 100644 --- a/heidisql.lpi +++ b/heidisql.lpi @@ -12,7 +12,6 @@ - @@ -49,26 +48,38 @@ - + - + - + - + - + + + + + + + + + + + + + diff --git a/heidisql.lpr b/heidisql.lpr index f3a4088f..70393e70 100644 --- a/heidisql.lpr +++ b/heidisql.lpr @@ -17,7 +17,7 @@ uses dbconnection, //gnugettext dbstructures, - dbstructures.mysql + dbstructures.mysql, About, generic_types ; {$R *.res} @@ -25,7 +25,7 @@ uses begin PostponedLogItems := TDBLogItems.Create(True); - //Application.MainFormOnTaskBar := True; + Application.MainFormOnTaskBar := True; // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator diff --git a/source/about.lfm b/source/about.lfm new file mode 100644 index 00000000..23db5c78 --- /dev/null +++ b/source/about.lfm @@ -0,0 +1,367 @@ +object AboutBox: TAboutBox + Left = 718 + Height = 464 + Top = 243 + Width = 589 + BorderStyle = bsDialog + Caption = 'About' + ClientHeight = 464 + ClientWidth = 589 + Color = clBtnFace + DesignTimePPI = 120 + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + FormStyle = fsStayOnTop + OnShow = FormShow + Position = poOwnerFormCenter + LCLVersion = '3.8.0.0' + object lblAppName: TLabel + Left = 146 + Height = 18 + Top = 10 + Width = 76 + Caption = 'lblAppName' + PopupMenu = popupLabels + end + object lblAppVersion: TLabel + Left = 146 + Height = 18 + Top = 54 + Width = 84 + Caption = 'lblAppVersion' + PopupMenu = popupLabels + end + object lblAppCompiled: TLabel + Left = 146 + Height = 18 + Top = 79 + Width = 95 + Caption = 'lblAppCompiled' + PopupMenu = popupLabels + end + object ImageHeidisql: TImage + Cursor = crHandPoint + Left = 10 + Height = 90 + Top = 10 + Width = 90 + AutoSize = True + OnClick = OpenURL + Picture.Data = { + 1754506F727461626C654E6574776F726B477261706869637B19000089504E47 + 0D0A1A0A0000000D494844520000005A0000005A080600000038A84102000000 + 017352474200AECE1CE90000000467414D410000B18F0BFC6105000000097048 + 597300000EC300000EC301C76FA8640000191049444154785EED9D09785445B6 + 804FEFE97427E9249D8424246C8140D8D7813008C8C8E0828A38038C0B9F2C3E + 9DE79BD1C7388CA3BEF17D9FCB387CF3D0270E8EC820E3CAA82808CAF2041150 + 82218448020102211BD9B7DED2FB3BE7F6EDD0F776DD4E774848FC3E7E387457 + DDBA756F9D3A75EA54F5ED066E70831BDC207264FC6BFF231D6431BA18ED94E9 + 63E306E6C4A528F5EE04851A743239A8E9B6BD1EB07B9D72B3CBA468AA2E31D5 + E7E79F6A6B6D6DB5430D78F91AFA15FD43D1690023470E8F9D76E7E0095189DE + 190AB577A24C09392AB53C03949E582F78E57C49263290BBC1256F7539BC155E + B7AC183BA0C0D9A4FA2E7F774551E1E95356A8E60BF6217DA7E87480390B27A6 + 0F9D1677975A27BF531D2D9F010A4F2C7FB44790B994CD2E3B1CF6DA949FD715 + 7A777DF2E1977568F17DC2755774EA8C44CDBC0747DD1E6D50AED2E8153783DC + ABE10FF52A328FC2E6B6C9F77BDA356F15ED6ADC77F4B36FEDFCA1EBC27553F4 + A40786C68C9D9BB62A3A4EF51BA5463698CFEE1272B8FE9BECA9F7E0509DF798 + 55AF5D390E6F6FDFB0CBC4E7F62A9DD7EE2D06CD4DD6CCBE6FF86A5DBCEA8F0A + B53C95CFEE17C89CCA2A8F39EACF970FBA37EFDAB2BB83CFEE157A4FD11835FC + F2C99FDC129FAA5DAF8A92E7F0B9FD1299535DE269D6AEF97463DEDE9A933564 + FC3D4EAF287ACE6F47270E9994F05774130FE00542460C52C814000AF4DE9CA8 + B01225E6514DFE3B467578DC282E1427801B3D2E4E7C14F6051689E0BDCC03B6 + A8F7EC9762D66CFAE3870D5C560FE2BF5ECF8091C4E227A6CE3566E8B628D5F2 + 417C6E589062D57A94180055B44FC111835A73A103705AD10DA3E7755A300B15 + 1F093297AAD2DBA25FF9FA739FECEFC908059BD733A8B3148A092B546BD3061B + FFA1D54427F0D9A1C16ED66040A74B0188C14E8A8A035046A1F55EC35D91E5AB + B4589701409BC877185ABEDBE13BDE25724F1C681D4BA7CF1EE74D4F18F5EDD9 + 936723EC2A363D62D11977446B53721D9B143AD77D3929D340AB42D30C012932 + 0A95A0C5EE20C55C0F48D1B626808E96F0AD5C61D76D739E4B5AF5C673FF30F3 + 59DDE69A159DBD5C1F1F3BCAB65DA671CFA1F4C8E4C9A057A36932201FAB35FA + 84F3B77D00F9746BBD4FE19C83EE02854B7B18AA92EF79EDC92D8D7C56B7B826 + 4567AFD025C50CEFF852AE714FE6B320C3301C52F4197C8A07AFA2261731006F + FC3A597057D0C469BE82AFE8C7BB42EE8E2A801AE36D1BD6FCB38ECF8A986E7B + C3E1F7EB1362B23BF6C9D5A864B20C5E1C38468D3A74B83C3254AC3E0D203AA9 + EFAC9805B92F0D0E3CBA3F07293B84757B65AE5499CE71F3CCDC39DB8FED2BC0 + A93672BAA5E8CC3BF4D109136C9FCBD4EEE97C56274E54B446A9052D8610143D + C465FA26B8C0CEE83782D0BD51A443110A858B5278E5AE5488EE989E3BE5968F + 8F7DF57DB8536B27112B5A335CA918BCC0F54F7417B7336F1EC5840E3035CD08 + F1196A9091736294E94FE2B76E0A0D3DB403C22843E291B906C9F4F6A193B2E7 + EEC83F921F51341299A2D1238C59A67C46A173FE07EB46FCA24BF780C7D804B1 + CA445002AE361865FA9B903DD03CE2C6C50F295C0AB7DC3126CAE0B5E77D5F72 + 1822D8258948D163566A6E51C53BDFC4B792DE36165D851E273D374EEFADF67A + D02A63412D27DFF1E380164D1499B843295B619F356B66EE77C73E2FBAC46775 + 49D851C78807F5C9BA61D60299D27375A613418B0E9AF884C820392A136508C8 + FBD36CD805149138DAF9040385477D59DF9235E52FBFDD1056D8179E45A7836C + E04D9EB770F2CB650D3B128A2A48D1AC6316671BB43AEA4025D38046AE6396E9 + 6FA2C6DB74D97CAE848547E6367854F6E431C372779EFCEE249F2B4D588A1EB3 + 42B35011E37C1E6F4026BE21121A6E8621F89E601C27F1BB92767B232830A622 + 85CBC21F507D02299BF64CC89588DBE3C110A5CE7279ECB986C28357F2AC1598 + 1B922E5B9A3E5F1F6D9C662D4297318CCF12404BE8C41CECB10817222AB90612 + A252215E3300340A8C03FB29B4B06927359282110B6ABEC9540B8D965A341E27 + 781D8AE3A7DFF5FED45D417B88D274A9E8B1BF53FF5E1EED78994F06119FE5DB + 18BA16B4CA18885327418C3A11DFEB7BCCD26538274429745C9DD4B1FE39C2EE + B68113E33872691E6F88E019F1E29FA6FA36A82E6F82564B0374D0D6A008578B + E6C1E2D7ECEFF04926215B34ECDE98045DB6A514E41E239F25803685E2823643 + 653024762C0C891B0B49DA0CD0ABE2B946AA155A6CA005578E76687734429DB5 + 1C2EB49D845ACB45FE3C1F4AB91A4618A6C2E8C499DCF931EA043C5FCD452E0E + 540E5991D5D5CEB9A11A3CB7DE7A993FD3A7D854DD5048D70D87A4E80CEC3C23 + E7A6A4F08207CC8E5668ECA8862B9632A8329F039BCB8C6202ABB31D2CAE56AE + 33C8ED359DF72D6A98B814E72EED568D37157548C62A21153DE63F554FCBB5E8 + 9B19D0FEB17194CF75F8D1AB0DF08B114F42BA7E389F131A1A8D254DDFC2CEB2 + 0D5C63540A0DDC93F50464C54F12DC981C2F460AA3D7AB22C7327268EAA881F3 + 2D27B851313C7E32762C7B43CB0FE762BD1E4EC91E7C258B26717B5D68043638 + 51B71FBEAEFA10EC2EA1E53A71626C3E876F781722C6D5A6595EB2C1FE4F3E19 + 84A4A2937FAA8F4E99693D8FD61C14B01114C6E992F904CFD2514F419661229F + 0A9FC3559FC0A1CA6DF0F3212B60EA80057C6EF8902593BBE15C0EF7F76AB368 + E8FBFED21F54B05742530134DAAAE09DE2FFE6AC3990F64ADF562B0BAF535150 + FCA1679AB78AED8B24035BE378E73D5E99278DEE4B2C341AC96DD0BEAE5FE254 + C9302C6E0226F0E4086562F23C0CFDB430DE388779BC2BF17AD032310AA051E1 + 76BBC08531995F284DF974DCEBA1C2EC3A02C51835107E96B95CD03E120A6109 + 964E40E99E38627ED44C5F8960D88AC6B859A672AD4203C0382658A213F11509 + BC890CFD489079D192E8A2118A5E6980F98396FB56908CE3D72AA408BBCD09ED + CDE87FCD76BC5FCA6497F54B4EE274D0C8748236929BA43D11964E50641802AF + C4774C98AE63F022DD305D96F52C561F3493D0C46D1C89AFA208FCE6C1CBE0A7 + 998BF8948FC62BCDF0D1E6DD70A5B21E1C762744456B60C8F00C58FAC89DA0D1 + AAF9523E6848CBB81DA8AB584C36F8F08D9D5079B11A3A6C0ED068D4903E6400 + 2C59BD10E21263F8526CCC6D56F8BF1D8721EFC0493877FA22B434B571D72062 + 62F5307844064CCA1D037317E6C2A0E1ECC5EE7B3FBC00652DA7F8940FDA0769 + C689918947DE5A77443BA831CF12B4A6642E5806CC91AD94A9DC0B583D4D9FC5 + 71E19C287F7CCA1C18A01386205FFCEB20BCFDCABFA0A2AC1AC3A32B70F97C15 + 14E615C34FE64C84E4346120C30AE94E1CFE01D63FBB092E5FA8F29D5F5605A7 + F3CF724ACA1AC57E068794B963EB3E787AF55FE0F0DE3CA8C2F36C566130E0B0 + 3BA0BEA6114EE595C08E77F7E17D55C38C799341A110AAA3BAFD022781EDA49D + 3E87191760B4511A90CF0978A3B406457E6381EB0CA50209761DE83640E15EC8 + 181A9C9092C9DD8B85E2D5A00BF3162486CB0E57187096292E4759E812FEE7A9 + B7E0D5E73683D914C6472708D57570F7B7F0DD570582BA48A21571CCB67286C6 + D00D894CED5A88EF82085274429A3651AEF24EE1DA22129A0469A33CD06FF945 + 01AAA0F2244C18E5D882FF48105C1660FBDB7B60D7B6FD7C89C820FF2DAE4F29 + 5333DB4A5B0E7838A83C09C8BD73D158555CA50104293A71144CC5F8329A5509 + 7D62C2BA3049445BA1585758489563E4934FDEB27E1B9F1232347B10AC7EF23E + 7876FDE3B0F6E57F87650FDFCDE50960CD56D46E465B692AE10C8E8E8B45EEC9 + 1C3A5D3F94AFA1932045A3E9CF600D0992508AF675B14824E00E89CBB22414A2 + B2DFECC9038B3978793CE7D65CF8FBCE9761D9BFDDC54D7C3F5F3C1B56FFFE57 + F0D6EE75F0B74F5E8419737D9F2B2726E1E423AAB30357295CFBC86588DA4BCF + 8EB07484AB1F99CAE0FC09BE132054344DBE32EF2471A57E516AF055E4AF3A05 + 6F4C2CDC0DB310950B252C58E58A0B4AF9A3421E7A6229C8E572E639D9E3B2E0 + F937D7C2962FD7C3D4D913828E9B3BDA7D6DA3F68BDA2BE54239915F7D2AC08F + D8A295A8E891E20B92503847A11DB362122C13680D924AF6C32ACF122944E59A + EAE8418D608C29F14165C592392C1D14144E88F21B4CD5ECB6A2D0F380621D75 + 0A7847D3B7180211285AA355E9650A6F2A6B482830EC15F76AA0703727869547 + 48E5874B04E7FFF03D2E07BA810D63B88AA673CCB69210D4372C5DA10F1F46B1 + 1BA63A11283A65B8D6E8F1B02742AEC3B11249619C837F99503EB33C43A41097 + 4B4C46CB65F0D767DEC038BE26A87C5772B2EA30385D4E765B79A19522EB5CF4 + 0A492A7AE6220081A29531AE54568524E43A58F97EE17A932E221616AC722C91 + 825176CC645CAE3268A86D825F2FFE03BCBFF1535C7EE3C285712E4BAC7613B3 + 9D8122A913AF373A79B04EB04B2F086A862ED5DC25D7D93FE39302E8712E4D88 + 55EF23B39E87CC84117CCAC7275B77C3C63F6FE55357997BDB4C9FEFEC829A8A + 3A38FAD5F77CEA2ABF7FE9D730FF6EEE51BF4E68F577FFCF1E83B616E94F5469 + E97DDB2FE6C1DDF72D80A4547EC346028BA31D5E3DB006CC76E10E5E20567A68 + B2994F88698B1B7BE1E3B6D37C4AE8470C63E453642ACF3D7C52003DCD431300 + ABF749A60CBA19E2E839D900CE9C3A0FF947847B0544F9F94A28293CD7A5545E + 623FA09C3B6F2A0C1B295C822B554A884F3460C71CE77382A1A577F1C952D8F1 + FE5EAE1387660F067D2CAE6819D0DE788C261E8A6BB03E467B49E89104C6072E + 1C7297FA9DE66247159F14BA0EF4DF1A96CF21A18A99C3C42F5446042BAF37B9 + E5AE9BE0FE47EEE553D2B89C2ED8F7D9D7B072E113F0CEEB1F83DB850D60307E + E04C88D7A6B0DB4BC2EB86256EAF5BB06B26701D8F3FFFD8F24119196FF34901 + 93274C82A444E9E1668C4D053505DA01BCFEDA46F8E3DAA7F954CFB1F1CDD7E1 + 57F72FE353C16CDFB603D6AC5903CDCD52E35AC8EC9B67C1B68FB681561BBCBA + 6DB53471FE9A457945059C3DCF8EDF4B4ACFCEDAF4E296237C52E83AE6DFBA20 + 273365C8629D3A16C49233641C0C340E0183D6C8141D3A703546F16A1C727EF9 + FE783EECDBB78FAFBDE758BCE85E983A699AE05A81327EFC7878E8A187C0E572 + 41515111389D213FA086CB972AE04A752DFCF2DEA54175E9357110AB4960B6D9 + 617583C5D411A42B92FAFAC637F2BEC9EBF47D02D7E1703ACCB491C31287C3C1 + CC0F2552BCF4D24BB073E7CE2EE5E9A7D9A381752DB124E2E85BB76E1D949595 + C19FFEF427484949E1CF66F3DE7BEFC1C1830783EAA13D72719E5F505FCC7C92 + 96B616335F358740D1EDA6F626D649241DF60E66BE5F2261FAF4E970EBADB776 + 2993264DE2CFE83E46A3119E79E619B870E102AC5FBF1EE2E3A5A39D8D1B37F2 + EF8261B539844E3C25E74A5AF95339048A2E2D2BADC517A6D6AC362BAB4281F4 + 67A2A2A2E0B1C71E83828202183D7A349F2BE4F0E1C3CC7688DBE917AB951D72 + A0CBB2149D2D12387681A28FE61F6DC2D5908555A9C982013C23BF2B91825556 + 2CA160950F47D2D3D361DBB66DDC469398C6C646A68B24C47924523AE97074D4 + E3BC20E805C1D57028986D365B0DEBE4B676DF676E52723DB9D6EB8D18310206 + 0E1CC8A784B0EA0E6CA75FC83F4B8D72547219FA050C00AF22EE563756C0DC85 + B175D83861554CD2D744720F1E8F07DADB835790090909A0560B3F3426A8BCB8 + BDAD6DAD92D74445178BBF0C2A5474355A75474781B852BF34363732F3A5440A + 5659299122B08CC96482CCCC4C58BD7A35D4D6D60A8EB1E4D34F3F85D656C15C + C53179B26F1B99758E581A9A1B98F92466ABB980AB2880204755DF54FF1DEB64 + 92FAC67A66BE5F7A1AF1E307525CBC7811EAEAEA60EBD6AD306AD42878FCF1C7 + 213F3F9FB3C440289E7EF7DD77E1E1871FE673842C59B2847F77156A17CBA243 + E8C2535C5A9CC79FDE4990A23FDBFBD90997DB258801FDD436D4322F4AC2422A + 3F5CC23D9F26303F168B850BD366CE9CC9F9E1D9B367C3C2850B61DEBC799091 + 91012B57AEE4468018EA2096A259EDB5DBEDD0DCCA5E75A2DFBEFCD1EE8FCAF9 + 6427418A2EAF2C6F36994DF9E2CA49C84737B53405E593B06E480A7139299142 + 5C2E2686BDADD8D4D404C78E1DE356A7478E1C819616F6A7307ABD9E1B0D4AA5 + 32A86E5A5D8AF3AAEBAA250D0E7574105D70D0523448D1F42B5BA8E8CF599590 + 54545730F3FB92ACACAC4EFF1A2903060C805DBB76C1B871E3F81C212C454BE9 + 80042D7D277FAA806045237927F376608F313708AA6AAB98B126F5B018952AE8 + F1060E563ED52126DCF32926DEBF7F3F3CFBECB39094C43F89D8055AAD161E79 + E411CE97D34A95052959AC680A73A5DC06466CCD1FECF8E0009F14C09E6DD240 + B6EE9975070DB186D97C8E809CE1399035388B4FF9D068349C0482110CECDEBD + 1B2E5DBAC4750E352E272707E6CF9F1FD644E776BB61CF9E3D505A5ACAD545F5 + 93F5DE76DB6D929D40D7A115DE37DF7CC36D28555757732B382A4F9D909D9DCD + F9EF050B1680C160E0CF6243FE9EEE219093C527A1B2A6924F09C10ED8B2F6B1 + B52BF8A400C9D6AE7D61ED83C33287057F3C824469A260DECC798267D5C8BFE9 + 74EC4DF470C08512D711FD05EA589AF402A105CA816F0F30472FE22D3A53346B + C38B1B8EF26901826DD2402A4D9517A74D98B61C951934D3D07022C5C6C7C50B + 8695D8A2C3856E9CAC8EB558E80B48C1D4F1816D23397DEE34B4B607C7DF84C5 + 6A39F1C26B2F3CE76DC7820C983E9AA8F8BEC28411C6DFC517F3CBB98BE704BB + 5734C4C416102E643DA46C7AED4BA81DE42EA8D3FDEDF20B29985C8638DF2FB8 + 987BC55325FDB57D498B269C5A6709FAE31568D541DF4FE314838A1E903480CF + F1593AF95E7229E1F860AA832CC7AF603A9FA0D112EE6285EAA086865B9E85BF + 93CD6673E73D0442F5E717E573ED658121DDD95736BFF21B6BBDB57B8AAE2CAD + B44E99394513A38B99CB67096837B7435C4C1CE8A27DBE996E88565F74D374C3 + 64E562A1E334615119B21C4A07E23F9F5EA93CD5438AF09F4F69FFF9647DFE8E + A23C7FD9508AA76381F741F7E0BF0F3AC6A2EC7219545E614F80044662BFDDFF + E1FE423EC9A44B33183D7774DCCA252B4FE104C8FCD52F8D5A03374DBBA9DBFE + B9B7112B5C4A9952B499DA68FB98EB4016E89B8F3DF5F253B35C158CA1104048 + 8B261ACA1BEC3993736A130D898B3119D431641DE4BFD207487E17BF4F21C506 + 4A249095E715E6715BA22CB03E67E9C5D265C7BF38DEE55794BB5434917721EF + 4CEEE4DCC968D5C227647868696E77D8213951F47DB81F31F41D44F2CB64D152 + 34B634FE6DDD1BEB3685F3BB1D61291A2BF2C6A6C67E9B919A711FAEC298C132 + AD98C8DE130CE1FDE45D7F862CFFD49953DC269A143831967E71F08B65189D85 + 156A85A768E46CE1D9B6ECF1D9E5A8C8C5E8F798BE9D369CE8F1578AAF7FAC90 + 924F979EE6B61AA4407FDD812E63D1F6CDDBCBF8AC2E095BD144DEC5BC3393C7 + 4E366094C1DE1C40E8C301FA78F7C768D934E19125875232E2ADAEAB5EF3EAE6 + 57B7F7DA4FFD50C5671BCE1E9A9033612A461BC2CD8E009A5A9BB890CB9860BC + A6F8F67A4213DF891F4E405D63E89FB66B6E6DDEFCD2EB2FFD97B73AB2993532 + 4523963A8BCBAD737F3978E0E0F92A95EAEA6A4504C5D8385940627C22B700E9 + CFB49BDAE178D1F190131F61B298F66CFD64EBF2E6E2E6D08F3E318858D1C4E5 + 33976DD129D15FA426A7DEAE5428251FC8A39554756D3568A3B49D8B9AFE04F9 + E34B9597A0F04C211735610028F9C762B31CDD7368CF3D85FB0BC3FB02A3886E + 299A282D2C6D37A41B766348776B2865BB71F94FB3B7C96C0243AC815B9E5303 + FB5A68C49D3C7D925BF1513A14569BF5E8A1E387EE3CF0D101F68E5218745BD1 + 444941496B7472F46729C694B9E81E42FEACBCD96AE61A458A8FD5C7321F60B9 + 1ED0282B2D2B85E273C55CFCDF1578DF7BF71FDEBFE8AB7F7DD56D2513D7A468 + A2F45469BB33DAF9517A4AFA38B54A1DF217516856A74F2748E12EB78B732781 + 7BDABD090E7D387FE93C17BAD14AB62B2B26B0DC3FDEDFF9FE83057B0BBAE52E + 02E9B190C038C6A859B574D5F34909494F60A41196F6E85764921293202D250D + 8CF1C61EB772EA4C7A2CA0A6AE868B84C2050DC25EDB58FB87F56FADFF5F77A5 + 9BBDC911213D1B7BA581ECD1071EBD7B50FAA08D2AA52AF473B222D0CF73114A + A221110C7106D047EB230E0D69C4D0F3702D6D2DDCE2A9B9AD99CB8B049C142F + 9457953FF4E6076F1EE9C9FF91A85782DC3B1EB863E0C4D1135F8D8B89A31FF0 + E8D635C8A5E8B43A88D646731F9DA15BE23A83AC1EA7334E81DC96A9D30136BB + CDB7DDD9618D58B17ED095B8D0556C3E927FE40F87B61FBA267FCCA25714CD91 + 0EF247EF7FF4AE810306FE25D4E2A63F80936241454DC5139B3ED874981EB7E0 + B37B94DE5334CFB019C3748B7EBEE8D184B884DFE102272277D2DBA09BB888BE + FB797413EF5ACE5B225E844442AF2BDACFC4F9130DF372E7AD4277F26BB470FF + 0F6CF609E86A4EB7B5B7BDBA7DEFF6F7CAF3CABB8EF17A80EBA6683F189D442D + 59B8E4F6F8D8F81538E1DD8C3E37821FFAE83E6EB7DB8C21DE170DCD0D6FE132 + FAEB8E8B1DBD6AC162AEBBA23B490398356D56DA947153EED045E916464545E5 + 62A4D2A35B7E3851D6E102E590C56AD9F975DED75F16161736F7E47F6213097D + A7E84050E918D2E9EEFCD99D63310E9F81AE6522461DA3D54A7526AE38E3BB8A + CB3162703A5DCE26A7D3598E2BCF62F4BD27AED45FF9EEE32F3F3EE37038E87F + EDEC73FA87A259D08F680168B20665C58CCD1E6B8C8F8B4F50ABD57A859C7ED0 + 02BCE80A1CA85053634B637361496103AE36CD182F38FA83526F70831BDCA047 + 00F87FF924EC272BA4FA450000000049454E44AE426082 + } + Transparent = True + end + object lblDonated: TLabel + Left = 146 + Height = 18 + Top = 214 + Width = 284 + Caption = 'I have donated per following email address:' + end + object lblEnvironment: TLabel + Left = 146 + Height = 18 + Top = 104 + Width = 93 + Caption = 'lblEnvironment' + PopupMenu = popupLabels + end + object lnklblWebpage: TLabel + Cursor = crHandPoint + Left = 146 + Height = 18 + Top = 129 + Width = 91 + Caption = 'lnklblWebpage' + ParentShowHint = False + ShowHint = True + OnClick = lnklblWebpageClick + end + object lnklblCredits: TLabel + Cursor = crHandPoint + Left = 146 + Height = 18 + Top = 154 + Width = 44 + Caption = 'Credits' + ParentShowHint = False + ShowHint = True + OnClick = lnklblCreditsClick + end + object btnClose: TButton + Left = 442 + Height = 31 + Top = 423 + Width = 125 + Anchors = [akRight, akBottom] + Cancel = True + Caption = 'Close' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object btnUpdateCheck: TButton + Left = 146 + Height = 31 + Top = 423 + Width = 288 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 1 + end + object editDonated: TEdit + Left = 146 + Height = 26 + Top = 238 + Width = 225 + TabOrder = 2 + TextHint = 'Email address' + OnEnter = editDonatedEnter + OnExit = editDonatedExit + end + object btnDonatedOK: TButton + Left = 379 + Height = 31 + Top = 236 + Width = 80 + Caption = 'OK' + TabOrder = 3 + OnClick = btnDonatedOKClick + end + object btnDonate: TButton + Left = 146 + Height = 92 + Hint = 'Send an arbitrary amount as donation to the author - per PayPal (also supports credit cards)' + Top = 272 + Width = 421 + Anchors = [akTop, akLeft, akRight] + Caption = 'Donate' + TabOrder = 4 + end + object lnklblCompiler: TLabel + Cursor = crHandPoint + Left = 308 + Height = 18 + Top = 79 + Width = 84 + Caption = 'lnklblCompiler' + ParentShowHint = False + ShowHint = True + OnClick = lnklblWebpageClick + end + object popupLabels: TPopupMenu + Images = MainForm.ImageListIcons8 + Left = 40 + Top = 180 + object menuCopyLabel: TMenuItem + Caption = 'Copy' + ImageIndex = 3 + OnClick = menuCopyLabelClick + end + end +end diff --git a/source/about.pas b/source/about.pas new file mode 100644 index 00000000..00aaebd9 --- /dev/null +++ b/source/about.pas @@ -0,0 +1,173 @@ +unit About; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ActnList, + ComCtrls, ExtCtrls, SynEdit, SynHighlighterSQL, laz.VirtualTrees, + RegExpr, Buttons, StdCtrls, Clipbrd, LCLIntf, StrUtils, LazVersion; + +type + TAboutBox = class(TForm) + btnClose: TButton; + lblAppName: TLabel; + lblAppVersion: TLabel; + lblAppCompiled: TLabel; + lnklblWebpage: TLabel; + btnUpdateCheck: TButton; + ImageHeidisql: TImage; + lblDonated: TLabel; + editDonated: TEdit; + btnDonatedOK: TButton; + lnklblCredits: TLabel; + popupLabels: TPopupMenu; + menuCopyLabel: TMenuItem; + lblEnvironment: TLabel; + btnDonate: TButton; + lnklblCompiler: TLabel; + procedure OpenURL(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure editDonatedEnter(Sender: TObject); + procedure editDonatedExit(Sender: TObject); + procedure btnDonatedOKClick(Sender: TObject); + procedure lnklblWebpageClick(Sender: TObject); + procedure lnklblCreditsClick(Sender: TObject); + procedure menuCopyLabelClick(Sender: TObject); + private + { Private declarations } + function GetCompilerVersion: String; + public + { Public declarations } + end; + +implementation + +uses + main, apphelpers, generic_types; + +{$R *.lfm} + + +procedure TAboutBox.OpenURL(Sender: TObject); +begin + LCLIntf.OpenURL(TControl(Sender).Hint); +end; + + +procedure TAboutBox.btnDonatedOKClick(Sender: TObject); +var + Check: TThreeStateBoolean; +begin + //AppSettings.WriteString(asDonatedEmail, editDonated.Text); + Check := MainForm.HasDonated(True); + case Check of + nbUnset: + MessageDialog(_('Could not check donation state.'), mtWarning, [mbOK]); + nbFalse: + ErrorDialog(_('Not a valid donor email address')); + nbTrue: + MessageDialog(_('Thanks for donating!'), mtInformation, [mbOK]); + end; + btnDonate.Visible := Check <> nbTrue; + MainForm.ToolButtonDonate.Visible := btnDonate.Visible; + MainForm.FormResize(Self); +end; + + +procedure TAboutBox.menuCopyLabelClick(Sender: TObject); +var + LabelComp: TComponent; +begin + // Copy label caption + LabelComp := PopupComponent(Sender); + if LabelComp is TLabel then begin + Clipboard.TryAsText := TLabel(LabelComp).Caption; + end; +end; + +procedure TAboutBox.editDonatedEnter(Sender: TObject); +begin + btnDonatedOK.Default := True; + btnClose.Default := False; +end; + + +procedure TAboutBox.editDonatedExit(Sender: TObject); +begin + btnDonatedOK.Default := False; + btnClose.Default := True; +end; + +procedure TAboutBox.FormShow(Sender: TObject); +var + OsMajor, OsMinor, OsBuild: Integer; +begin + Screen.Cursor := crHourGlass; + + // Apply special font properties after form creation, as that disables ParentFont, which prevents InheritFont() to apply + lblAppName.Font.Size := Round(lblAppName.Font.Size * 1.5); + lblAppName.Font.Style := [fsBold]; + + btnDonate.Caption := f_('Donate to the %s project', [APPNAME]); + btnDonate.Visible := MainForm.HasDonated(False) <> nbTrue; + btnDonate.OnClick := MainForm.DonateClick; + editDonated.Text := ''; //AppSettings.ReadString(asDonatedEmail); + + // Assign text + Caption := f_('About %s', [APPNAME]); + lblAppName.Caption := APPNAME; + lblAppVersion.Caption := _('Version') + ' ' + Mainform.AppVersion; + lblAppCompiled.Caption := _('Compiled on:') + ' ' + {DateTimeToStr(GetImageLinkTimeStamp(Application.ExeName)) +} ' with'; + lnklblCompiler.Top := lblAppCompiled.Top; + lnklblCompiler.Left := lblAppCompiled.Left + lblAppCompiled.Width + Canvas.TextWidth(' '); + lnklblCompiler.Caption := GetCompilerVersion; + lnklblCompiler.Hint := 'https://www.lazarus-ide.org/?utm_source='+APPNAME; + lnklblWebpage.Caption := APPDOMAIN; + lnklblWebpage.Hint := APPDOMAIN+'?place='+EncodeURLParam(lnklblWebpage.Name); + + lnklblCompiler.Font.Style := lnklblCompiler.Font.Style + [fsUnderline]; + lnklblWebpage.Font.Style := lnklblWebpage.Font.Style + [fsUnderline]; + lnklblCredits.Font.Style := lnklblCredits.Font.Style + [fsUnderline]; + + ImageHeidisql.Hint := APPDOMAIN+'?place='+EncodeURLParam(ImageHeidisql.Name); + lblEnvironment.Caption := _('Environment:'); + if IsWine then begin + lblEnvironment.Caption := lblEnvironment.Caption + + ' Linux/Wine'; + end else begin + OsMajor := Win32MajorVersion; + OsMinor := Win32MinorVersion; + OsBuild := Win32BuildNumber; + if (OsMajor = 10) and (OsBuild >= 22000) then + OsMajor := 11; + lblEnvironment.Caption := lblEnvironment.Caption + + ' Windows ' + + IntToStr(OsMajor) + + IfThen(OsMinor > 0, '.'+IntToStr(OsMinor), '') + + ' Build '+IntToStr(OsBuild); + end; + + Screen.Cursor := crDefault; + btnClose.TrySetFocus; +end; + + +procedure TAboutBox.lnklblCreditsClick(Sender: TObject); +begin + Help(Sender, 'credits'); +end; + +procedure TAboutBox.lnklblWebpageClick(Sender: TObject); +begin + LCLIntf.OpenURL((Sender as TLabel).Hint); +end; + +function TAboutBox.GetCompilerVersion: string; +begin + Result := 'Lazarus IDE v' + LazVersion.laz_version + ' & FreePascal v' + {$I %FPCVERSION%}; +end; + +end. + diff --git a/source/apphelpers.pas b/source/apphelpers.pas index fc082448..ecd90860 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, Generics.Collections, Generics.Defaults, Controls, RegExpr, Math, FileUtil, - StrUtils, Graphics, GraphUtil, LCLIntf, Forms, Clipbrd, + StrUtils, Graphics, GraphUtil, LCLIntf, Forms, Clipbrd, Process, ActnList, Menus, Dialogs, + Character, dbconnection, dbstructures; type @@ -345,7 +346,7 @@ type function UnformatNumber(Val: String): String; function FormatNumber( int: Int64; Thousands: Boolean=True): String; Overload; function FormatNumber( flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload; - //procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); + procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); function getFirstWord(text: String; MustStartWithWordChar: Boolean=True): String; function RegExprGetMatch(Expression: String; var Input: String; ReturnMatchNum: Integer; DeleteFromSource, CaseInsensitive: Boolean): String; Overload; function RegExprGetMatch(Expression: String; Input: String; ReturnMatchNum: Integer): String; Overload; @@ -381,7 +382,7 @@ type //function ParamBlobToStr(lpData: Pointer): String; //function ParamStrToBlob(out cbData: DWORD): Pointer; //function CheckForSecondInstance: Boolean; - //function GetParentFormOrFrame(Comp: TWinControl): TWinControl; + function GetParentFormOrFrame(Comp: TWinControl): TWinControl; //function KeyPressed(Code: Integer): Boolean; //function GeneratePassword(Len: Integer): String; //procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean); @@ -394,10 +395,10 @@ type //function GetImageLinkTimeStamp(const FileName: string): TDateTime; function IsEmpty(Str: String): Boolean; function IsNotEmpty(Str: String): Boolean; - //function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; overload; - //function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; overload; - //function ErrorDialog(Msg: string): Integer; overload; - //function ErrorDialog(const Title, Msg: string): Integer; overload; + function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; overload; + function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; overload; + function ErrorDialog(Msg: string): Integer; overload; + function ErrorDialog(const Title, Msg: string): Integer; overload; //function GetLocaleString(const ResourceId: Integer): WideString; //function GetHTMLCharsetByEncoding(Encoding: TEncoding): String; //procedure ParseCommandLine(CommandLine: String; var ConnectionParams: TConnectionParameters; var FileNames: TStringList; var RunFrom: String); @@ -408,7 +409,7 @@ type //function GetSystemImageList: TImageList; //function GetSystemImageIndex(Filename: String): Integer; //function GetExecutableBits: Byte; - //procedure Help(Sender: TObject; Anchor: String); + procedure Help(Sender: TObject; Anchor: String); //function PortOpen(Port: Word): Boolean; //function IsValidFilePath(FilePath: String): Boolean; //function FileIsWritable(FilePath: String): Boolean; @@ -419,8 +420,8 @@ type //function ProcessExists(pid: Cardinal; ExeNamePattern: String): Boolean; //procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean); //function SynCompletionProposalPrettyText(ImageIndex: Integer; LeftText, CenterText, RightText: String; LeftColor: TColor=-1; CenterColor: TColor=-1; RightColor: TColor=-1): String; - //function PopupComponent(Sender: TObject): TComponent; - //function IsWine: Boolean; + function PopupComponent(Sender: TObject): TComponent; + function IsWine: Boolean; function DirSep: Char; //procedure FindComponentInstances(BaseForm: TComponent; ClassType: TClass; var List: TObjectList); //function WebColorStrToColorDef(WebColor: string; Default: TColor): TColor; @@ -432,7 +433,7 @@ var //AppSettings: TAppSettings; MutexHandle: THandle = 0; SystemImageList: TImageList = nil; - //mtCriticalConfirmation: TMsgDlgType = mtCustom; + mtCriticalConfirmation: TMsgDlgType = mtCustom; //ConfirmIcon: TIcon; NumberChars: TSysCharSet; LibHandleUser32: THandle; @@ -989,25 +990,27 @@ end; {*** - Open URL or execute system command - - @param string Command or URL to execute - @param string Working directory, only usefull is first param is a system command + Execute system command + Don't use for opening URL } -{procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); +procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); var Msg: String; - ShowCmd: Integer; + ShowOptions: TShowWindowOptions; + ProcessResult: String; begin - ShowCmd := IfThen(RunHidden, SW_HIDE, SW_SHOWNORMAL); + if RunHidden then + ShowOptions := swoHIDE + else + ShowOptions := swoNone; Msg := 'Executing shell command: "'+cmd+'"'; if not path.IsEmpty then Msg := Msg + ' path: "'+path+'"'; if not params.IsEmpty then Msg := Msg + ' params: "'+params+'"'; MainForm.LogSQL(Msg, lcDebug); - ShellExecute(0, 'open', PChar(cmd), PChar(params), PChar(path), ShowCmd); -end;} + Process.RunCommandInDir(path, cmd, [params], ProcessResult, [], ShowOptions); +end; @@ -2053,7 +2056,7 @@ begin end;} -{function GetParentFormOrFrame(Comp: TWinControl): TWinControl; +function GetParentFormOrFrame(Comp: TWinControl): TWinControl; begin Result := Comp; while True do begin @@ -2069,7 +2072,7 @@ begin if (not Assigned(Result)) or (Result is TCustomForm) or (Result is TFrame) then break; end; -end;} +end; {function KeyPressed(Code: Integer): Boolean; @@ -2317,13 +2320,13 @@ begin end; -{function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; +function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; begin Result := MessageDialog('', Msg, DlgType, Buttons); -end;} +end; -{function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; +function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; var m: String; Dialog: TTaskDialog; @@ -2344,13 +2347,13 @@ var if ResourceId > 0 then begin // Prefer string from user32.dll // May be empty on Wine! - cap := GetLocaleString(ResourceId) + //cap := GetLocaleString(ResourceId) end; if cap.IsEmpty then begin cap := _(BtnCaption); for i:=1 to Length(cap) do begin // Auto apply hotkey - if (Pos(LowerCase(cap[i]), Hotkeys) = 0) and cap[i].IsLetter then begin + if (Pos(LowerCase(cap[i]), Hotkeys) = 0) and IsLetter(cap[i]) then begin Hotkeys := Hotkeys + LowerCase(cap[i]); Insert('&', cap, i); break; @@ -2364,137 +2367,97 @@ var end; begin // Remember current path and restore it later, so the caller does not try to read from the wrong path after this dialog - AppSettings.StorePath; + //AppSettings.StorePath; - if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin - // Use modern task dialog on Vista and above - Dialog := TTaskDialog.Create(nil); - Dialog.Flags := [tfEnableHyperlinks, tfAllowDialogCancellation]; - Dialog.CommonButtons := []; - if Assigned(MainForm) then - Dialog.OnHyperlinkClicked := MainForm.TaskDialogHyperLinkClicked; + Dialog := TTaskDialog.Create(nil); + Dialog.Flags := [tfEnableHyperlinks, tfAllowDialogCancellation]; + Dialog.CommonButtons := []; - // Caption, title and text - case DlgType of - mtWarning: Dialog.Caption := _('Warning'); - mtError: Dialog.Caption := _('Error'); - mtInformation: Dialog.Caption := _('Information'); - mtConfirmation, mtCustom: Dialog.Caption := _('Confirm'); + // Caption, title and text + case DlgType of + mtWarning: Dialog.Caption := _('Warning'); + mtError: Dialog.Caption := _('Error'); + mtInformation: Dialog.Caption := _('Information'); + mtConfirmation, mtCustom: Dialog.Caption := _('Confirm'); + end; + if Title <> Dialog.Caption then + Dialog.Title := Title; + Dialog.Text := Msg; + + // Main icon, and footer link + case DlgType of + mtWarning: + Dialog.MainIcon := tdiWarning; + mtError: begin + Dialog.MainIcon := tdiError; + Dialog.FooterText := FooterText; + Dialog.FooterIcon := tdiInformation; end; - if Title <> Dialog.Caption then - Dialog.Title := Title; - if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) then - Dialog.Caption := MainForm.ActiveConnection.Parameters.SessionName + ': ' + Dialog.Caption; - rx := TRegExpr.Create; - rx.Expression := 'https?://[^\s"]+'; - if ThemeIsDark then - Dialog.Text := Msg - else // See issue #2036 - Dialog.Text := rx.Replace(Msg, '$0', True); - rx.Free; - - // Main icon, and footer link - case DlgType of - mtWarning: - Dialog.MainIcon := tdiWarning; - mtError: begin - Dialog.MainIcon := tdiError; - WebSearchUrl := AppSettings.ReadString(asWebSearchBaseUrl); - WebSearchUrl := StringReplace(WebSearchUrl, '%q', EncodeURLParam(Copy(Msg, 1, 1000)), []); - rx := TRegExpr.Create; - rx.Expression := 'https?://(www\.)?([^/]+)/'; - if rx.Exec(WebSearchUrl) then - WebSearchHost := rx.Match[2] - else - WebSearchHost := '[unknown host]'; - rx.Free; - Dialog.FooterText := IfThen(FooterText.IsEmpty, '', FooterText + sLineBreak + sLineBreak) + - ''+_('Find some help on this error')+' (=> '+WebSearchHost+')'; - Dialog.FooterIcon := tdiInformation; - end; - mtInformation: - Dialog.MainIcon := tdiInformation; - mtConfirmation, mtCustom: begin - Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; - Dialog.CustomMainIcon := ConfirmIcon; - end; - else - Dialog.MainIcon := tdiNone; + mtInformation: + Dialog.MainIcon := tdiInformation; + mtConfirmation, mtCustom: begin + Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; + Dialog.MainIcon := tdiQuestion; end; - - // Add buttons - for MsgButton in Buttons do begin - case MsgButton of - mbYes: AddButton('Yes', mrYes, 805); - mbNo: AddButton('No', mrNo, 806); - mbOK: AddButton('OK', mrOk, 800); - mbCancel: AddButton('Cancel', mrCancel, 801); - mbAbort: AddButton('Abort', mrAbort, 802); - mbRetry: AddButton('Retry', mrRetry, 803); - mbIgnore: AddButton('Ignore', mrIgnore, 804); - mbAll: AddButton('All', mrAll); - mbNoToAll: AddButton('No to all', mrNoToAll); - mbYesToAll: AddButton('Yes to all', mrYesToAll); - mbClose: AddButton('Close', mrClose, 807); - end; - end; - - // Checkbox, s'il vous plait? - KeepAskingValue := True; - if KeepAskingSetting <> asUnused then begin - if (not (mbNo in Buttons)) and (Buttons <> [mbOK]) then - raise Exception.CreateFmt(_('Missing "No" button in %() call'), ['MessageDialog']); - KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting); - Dialog.Flags := Dialog.Flags + [tfVerificationFlagChecked]; - if Buttons = [mbOK] then - Dialog.VerificationText := _('Keep showing this dialog.') - else - Dialog.VerificationText := _('Keep asking this question.'); - end; - - // Supress dialog and assume "No" if user disabled this dialog - if KeepAskingValue then begin - Dialog.Execute; - Result := Dialog.ModalResult; - if (KeepAskingSetting <> asUnused) and (not (tfVerificationFlagChecked in Dialog.Flags)) then - AppSettings.WriteBool(KeepAskingSetting, False); - end else - Result := mrNo; - - Dialog.Free; - end else begin - // Backwards compatible dialog on Windows XP - m := Msg; - if not Title.IsEmpty then - m := Title + SLineBreak + SLineBreak + m; - if not FooterText.IsEmpty then - m := m + SLineBreak + SLineBreak + FooterText; - - if KeepAskingSetting <> asUnused then - KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting) else - KeepAskingValue := True; - - if KeepAskingValue then - Result := MessageDlg(m, DlgType, Buttons, 0) - else - Result := mrNo; + Dialog.MainIcon := tdiNone; end; - AppSettings.RestorePath; -end;} + // Add buttons + for MsgButton in Buttons do begin + case MsgButton of + mbYes: AddButton('Yes', mrYes, 805); + mbNo: AddButton('No', mrNo, 806); + mbOK: AddButton('OK', mrOk, 800); + mbCancel: AddButton('Cancel', mrCancel, 801); + mbAbort: AddButton('Abort', mrAbort, 802); + mbRetry: AddButton('Retry', mrRetry, 803); + mbIgnore: AddButton('Ignore', mrIgnore, 804); + mbAll: AddButton('All', mrAll); + mbNoToAll: AddButton('No to all', mrNoToAll); + mbYesToAll: AddButton('Yes to all', mrYesToAll); + mbClose: AddButton('Close', mrClose, 807); + end; + end; + + // Checkbox, s'il vous plait? + KeepAskingValue := True; + if KeepAskingSetting <> asUnused then begin + if (not (mbNo in Buttons)) and (Buttons <> [mbOK]) then + raise Exception.CreateFmt(_('Missing "No" button in %() call'), ['MessageDialog']); + KeepAskingValue := True; //AppSettings.ReadBool(KeepAskingSetting); + Dialog.Flags := Dialog.Flags + [tfVerificationFlagChecked]; + if Buttons = [mbOK] then + Dialog.VerificationText := _('Keep showing this dialog.') + else + Dialog.VerificationText := _('Keep asking this question.'); + end; + + // Supress dialog and assume "No" if user disabled this dialog + if KeepAskingValue then begin + Dialog.Execute; + Result := Dialog.ModalResult; + //if (KeepAskingSetting <> asUnused) and (not (tfVerificationFlagChecked in Dialog.Flags)) then + // AppSettings.WriteBool(KeepAskingSetting, False); + end else + Result := mrNo; + + Dialog.Free; + + //AppSettings.RestorePath; +end; -{function ErrorDialog(Msg: string): Integer; +function ErrorDialog(Msg: string): Integer; begin Result := MessageDialog('', Msg, mtError, [mbOK]); -end;} +end; -{function ErrorDialog(const Title, Msg: string): Integer; +function ErrorDialog(const Title, Msg: string): Integer; begin Result := MessageDialog(Title, Msg, mtError, [mbOK]); -end;} +end; {function GetLocaleString(const ResourceId: Integer): WideString; @@ -2787,7 +2750,7 @@ begin} //end; -{procedure Help(Sender: TObject; Anchor: String); +procedure Help(Sender: TObject; Anchor: String); var Place: String; begin @@ -2800,8 +2763,8 @@ begin Place := 'unhandled-'+Sender.ClassName; if not Anchor.IsEmpty then Anchor := '#'+Anchor; - ShellExec(APPDOMAIN+'help.php?place='+EncodeURLParam(Place)+Anchor); -end;} + LCLIntf.OpenURL(APPDOMAIN+'help.php?place='+EncodeURLParam(Place)+Anchor); +end; {function PortOpen(Port: Word): Boolean; @@ -2926,7 +2889,7 @@ const} end;} -{function PopupComponent(Sender: TObject): TComponent; +function PopupComponent(Sender: TObject): TComponent; var Menu: TObject; begin @@ -2943,14 +2906,17 @@ begin if Menu is TPopupMenu then Result := (Menu as TPopupMenu).PopupComponent; -end;} +end; -{function IsWine: Boolean; +function IsWine: Boolean; +{$IfDef WINDOWS} var NTHandle: THandle; wine_nt_to_unix_file_name: procedure(p1:pointer; p2:pointer); stdcall; +{$EndIf} begin + {$IfDef WINDOWS} // Detect if we're running on Wine, not on native Windows // Idea taken from http://ruminatedrumblings.blogspot.com/2008/04/detecting-virtualized-environment.html if IsWineStored = -1 then begin @@ -2962,8 +2928,12 @@ begin IsWineStored := IfThen(Assigned(wine_nt_to_unix_file_name), 1, 0); FreeLibrary(NTHandle); end; + {$EndIf} + {$IfDef LINUX} + IsWineStored := 0; + {$EndIf} Result := IsWineStored = 1; -end;} +end; function DirSep: Char; diff --git a/source/generic_types.pas b/source/generic_types.pas new file mode 100644 index 00000000..8d8caa26 --- /dev/null +++ b/source/generic_types.pas @@ -0,0 +1,13 @@ +unit generic_types; + +{$mode delphi}{$H+} + +interface + +type + TThreeStateBoolean = (nbUnset, nbFalse, nbTrue); + + +implementation + +end. diff --git a/source/main.lfm b/source/main.lfm index f6d59b22..d21ace40 100644 --- a/source/main.lfm +++ b/source/main.lfm @@ -1,7 +1,7 @@ object MainForm: TMainForm - Left = 585 + Left = 549 Height = 500 - Top = 289 + Top = 272 Width = 998 Caption = 'MainForm' ClientHeight = 500 @@ -59,6 +59,11 @@ object MainForm: TMainForm Action = actSessionManager Style = tbsDropDown end + object ToolButtonDonate: TToolButton + Left = 45 + Top = 2 + Caption = 'ToolButtonDonate' + end end inline SynMemoSQLLog: TSynEdit Left = 0 diff --git a/source/main.pas b/source/main.pas index 7af019c7..19a725c6 100644 --- a/source/main.pas +++ b/source/main.pas @@ -7,9 +7,9 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ActnList, ComCtrls, ExtCtrls, SynEdit, SynHighlighterSQL, laz.VirtualTrees, - RegExpr, Buttons, StdCtrls, + RegExpr, Buttons, StdCtrls, fphttpclient, Math, LCLIntf, Generics.Collections, Generics.Defaults, - dbconnection, dbstructures, dbstructures.mysql; + dbconnection, dbstructures, dbstructures.mysql, generic_types; type @@ -228,6 +228,7 @@ type ToolBarTree: TToolBar; ToolBarMainButtons: TToolBar; ToolButton1: TToolButton; + ToolButtonDonate: TToolButton; //procedure actCreateDBObjectExecute(Sender: TObject); //procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); @@ -237,7 +238,7 @@ type procedure FormCreate(Sender: TObject); procedure AfterFormCreate; //procedure FormShow(Sender: TObject); - //procedure FormResize(Sender: TObject); + procedure FormResize(Sender: TObject); //procedure AddEditorCommandMenu(const S: string); //procedure EditorCommandOnClick(Sender: TObject); //procedure actUserManagerExecute(Sender: TObject); @@ -540,7 +541,7 @@ type //procedure menuClearDataTabFilterClick(Sender: TObject); //procedure actUnixTimestampColumnExecute(Sender: TObject); //procedure PopupQueryLoadPopup(Sender: TObject); - //procedure DonateClick(Sender: TObject); + procedure DonateClick(Sender: TObject); //procedure DBtreeExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); //procedure ApplicationDeActivate(Sender: TObject); //procedure ApplicationShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); @@ -681,7 +682,7 @@ type FTimeZoneOffset: Integer; FGridCopying: Boolean; FGridPasting: Boolean; - //FHasDonatedDatabaseCheck: TThreeStateBoolean; + FHasDonatedDatabaseCheck: TThreeStateBoolean; //FFocusedTables: TDBObjectList; FLastCaptionChange: Cardinal; FListTablesSorted: Boolean; @@ -819,7 +820,7 @@ type //procedure ProgressStep; //procedure SetProgressState(State: TProgressbarState); //procedure TaskDialogHyperLinkClicked(Sender: TObject); - //function HasDonated(ForceCheck: Boolean): TThreeStateBoolean; + function HasDonated(ForceCheck: Boolean): TThreeStateBoolean; //procedure ApplyVTFilter(FromTimer: Boolean); //procedure ApplyFontToGrids; //procedure PrepareImageList; @@ -856,7 +857,7 @@ const implementation uses - FileInfo, winpeimagereader, elfreader, machoreader, apphelpers; + FileInfo, winpeimagereader, elfreader, machoreader, apphelpers, About; {$R *.lfm} @@ -1694,9 +1695,9 @@ begin SessionPaths := TStringList.Create; AppSettings.GetSessionPaths('', SessionPaths);} - {// Probably hide image + // Probably hide image FHasDonatedDatabaseCheck := nbUnset; - ToolBarDonate.Visible := HasDonated(True) <> nbTrue;} + //ToolBarDonate.Visible := HasDonated(True) <> nbTrue; {// Call user statistics if checked in settings if AppSettings.ReadBool(asDoUsageStatistics) then begin @@ -2227,7 +2228,7 @@ begin Help(Sender, ''); end;} -{procedure TMainForm.FormResize(Sender: TObject); +procedure TMainForm.FormResize(Sender: TObject); var PanelRect: TRect; w0, w1, w2, w3, w4, w5, w6: Integer; @@ -2236,7 +2237,7 @@ var var MaxPixels: Integer; begin - MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + VirtualImageListMain.Width + 20; + MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + ImageListIcons8.Width + 20; Result := Round(Min(MaxPixels, Width / 100 * MaxPercentage)); end; begin @@ -2265,7 +2266,7 @@ begin StatusBar.Panels[6].Width := w6; // Retreive the rectancle of the statuspanel (in our case the fifth panel) - if not IsWine then begin + {if not IsWine then begin SendMessage(StatusBar.Handle, SB_GETRECT, 5, Integer(@PanelRect)); // Position the progressbar over the panel on the statusbar ProgressBarStatus.SetBounds( @@ -2274,20 +2275,20 @@ begin PanelRect.Right-PanelRect.Left, PanelRect.Bottom-PanelRect.Top ); - end; + end;} - lblDataTop.Width := pnlDataTop.Width - tlbDataButtons.Width - 10; - FixQueryTabCloseButtons; + {lblDataTop.Width := pnlDataTop.Width - tlbDataButtons.Width - 10; + FixQueryTabCloseButtons;} // Right aligned button // Do not set ToolBar.Align to alRight. See issue #1967 - if ToolBarDonate.Visible then begin + {if ToolBarDonate.Visible then begin //ToolBarDonate.Width := ToolBarDonate.Buttons[0].Width; ToolBarDonate.Left := ControlBarMain.Width - ToolBarDonate.Width; //ToolBarDonate.Buttons[0].Height := ToolBarMainButtons.Buttons[0].Height; - end; + end;} -end;} +end; {procedure TMainForm.FormShow(Sender: TObject); begin @@ -2607,7 +2608,7 @@ begin end;} -{procedure TMainForm.DonateClick(Sender: TObject); +procedure TMainForm.DonateClick(Sender: TObject); var Dialog: TWinControl; place: String; @@ -2622,9 +2623,9 @@ begin ErrorDialog(f_('Could not determine parent form of this %s', [Sender.ClassName])) else begin place := LowerCase(Dialog.UnitName); - ShellExec(APPDOMAIN + 'donatebutton.php?place=' + EncodeURLParam(place)); + OpenURL(APPDOMAIN + 'donatebutton.php?place=' + EncodeURLParam(place)); end; -end;} +end; {procedure TMainForm.actExportSettingsExecute(Sender: TObject); @@ -14302,15 +14303,15 @@ begin end;} -{function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean; +function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean; var Email, CheckResult: String; rx: TRegExpr; - CheckWebpage: THttpDownload; + CheckWebpage: TFPHttpClient; begin Screen.Cursor := crHourGlass; if (FHasDonatedDatabaseCheck = nbUnset) or (ForceCheck) then begin - Email := AppSettings.ReadString(asDonatedEmail); + Email := ''; //AppSettings.ReadString(asDonatedEmail); if Email = '' then begin // Nothing to check, we know this is not valid FHasDonatedDatabaseCheck := nbFalse; @@ -14321,11 +14322,9 @@ begin // = 1 : Not a donor // = 2 : Valid donor rx := TRegExpr.Create; - CheckWebpage := THttpDownload.Create(MainForm); - CheckWebpage.URL := APPDOMAIN + 'hasdonated.php?email='+EncodeURLParam(Email); + CheckWebpage := TFPHttpClient.Create(MainForm); try - CheckWebpage.SendRequest(''); - CheckResult := CheckWebpage.LastContent; + CheckResult := CheckWebpage.Get(APPDOMAIN + 'hasdonated.php?email='+EncodeURLParam(Email)); LogSQL('HTTP response: "'+CheckResult+'"', lcDebug); rx.Expression := '^\d'; if rx.Exec(CheckResult) then begin @@ -14346,7 +14345,7 @@ begin end; Result := FHasDonatedDatabaseCheck; Screen.Cursor := crDefault; -end;} +end; {procedure TMainForm.actPreviousResultExecute(Sender: TObject);